home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1998 March / Macworld (1998-03) (Disk 1).dmg / Shareware World / Utilities / Text Processing / Alpha / Tcl / Packages / copyRing.tcl < prev    next >
Encoding:
Text File  |  1997-12-01  |  2.9 KB  |  137 lines  |  [TEXT/ALFA]
  1. # (install)
  2. # Implementation of Emacs's kill ring. This is a paste ring.
  3.  
  4. alpha::extension copyRing 0.1.1 {
  5.     menu::replaceWith Edit "/X<Scut" items "/X<Scut" "/X<S<I<Ocut&Append"
  6.     menu::replaceWith Edit "/C<Scopy" items "/C<Scopy" "/C<S<I<Ocopy&Append"
  7.     menu::replaceWith Edit "/V<Spaste" items "/V<Spaste" "/V<S<I<OpastePop"
  8.     if {[info commands copyringCopy] == ""} {
  9.         set renamedRing 1
  10.         rename copy copyringCopy
  11.         rename cut copyringCut
  12.         rename paste copyringPaste
  13.     }
  14. } help {
  15.     Provides an implementation of a copy/paste ring.
  16. }
  17.  
  18. set ringDepth     5
  19. set ringIn         0
  20. set ringOut         0
  21. set pasteStart     0
  22. set pasteFinish    0
  23.  
  24. proc copy&Append {} {
  25.     set old [getScrap]
  26.     putScrap "$old[getSelect]"
  27.     message "Appended"
  28. }
  29.  
  30.  
  31. proc cut&Append {} {
  32.     set old [getScrap]
  33.     putScrap "$old[getSelect]"
  34.     deleteText [getPos] [selEnd]
  35.     message "Appended"
  36. }
  37.  
  38.  
  39.  
  40. proc copy {} {
  41.     global copyring ringDepth ringIn
  42.     
  43.     set len [expr [selEnd] - [getPos]]
  44.     if {!$len} {
  45.         if {[getMark] < [getPos]} {
  46.             set text [getText [getMark] [getPos]]
  47.             set len [expr [getPos] - [getMark]]
  48.         } else {
  49.             set text [getText [getPos] [getMark]]
  50.             set len [expr [getMark] - [getPos]]
  51.         }
  52.         if {![string length $text]} return
  53.     } else {
  54.         set text [getSelect]
  55.     }
  56.  
  57.  
  58.     set copyring([expr {$ringIn % $ringDepth}]) $text
  59.     incr ringIn
  60.     
  61.     copyringCopy
  62. }
  63.  
  64.  
  65. proc cut {{rect 0}} {
  66.     global copyring ringDepth ringIn intelCutPaste
  67.     
  68.     set len [expr [selEnd] - [getPos]]
  69.     if {!$len} {
  70.         if {[getMark] < [getPos]} {
  71.             set text [getText [getMark] [getPos]]
  72.             set len [expr [getPos] - [getMark]]
  73.         } else {
  74.             set text [getText [getPos] [getMark]]
  75.             set len [expr [getMark] - [getPos]]
  76.         }
  77.         if {![string length $text]} return
  78.     } else {
  79.         set text [getSelect]
  80.     }
  81.  
  82.     set copyring([expr {$ringIn % $ringDepth}]) $text
  83.     incr ringIn
  84.  
  85.     copyringCut
  86.  
  87.     if {$intelCutPaste && !$rect} {
  88.         if {[isWhite 0] && [isWhite -1]} {
  89.             backSpace
  90.         }
  91.     }
  92. }
  93.  
  94. proc paste {{rect 0}} {
  95.     global copyring ringDepth ringIn ringOut intelCutPaste pasteStart pasteFinish
  96.     set intel 0
  97.     set ringOut [expr {($ringIn - 1) % $ringDepth}]
  98.     if {!$rect && $intelCutPaste} {
  99.         set left -1
  100.         set right [expr [selEnd] - [getPos]]
  101.         if {[isWhite $right] && [isChar $left]} {
  102.             clear
  103.             insertText " "
  104.         } elseif {[isWhite $left] && [isChar $right]} {set intel 1}
  105.     }
  106.     copyringPaste
  107.     set pasteStart [getMark]
  108.     set pasteFinish [getPos]
  109.     if {$intel && ([lookAt [expr [getPos]-1]] != "\r")} {
  110.         insertText " "
  111.     }
  112. }
  113.  
  114.  
  115. proc isWhite {off} {
  116.     set c [lookAt [expr [getPos] + $off]]
  117.     return [expr {($c == " ")}]
  118. }
  119.  
  120. proc isChar {off} {
  121.     set c [lookAt [expr [getPos] + $off]]
  122.     return [expr {[string match {[a-z]} $c]}]
  123. }
  124.  
  125.     
  126. proc pastePop {} {
  127.     global copyring ringDepth ringIn ringOut pasteFinish pasteStart
  128.     
  129.     if {!$ringIn} { beep; return}
  130.     
  131.     set ringOut [expr $ringOut-1]
  132.     if {$ringOut < 0} {set ringOut [expr (($ringDepth > $ringIn) ? $ringIn : $ringDepth) - 1]}
  133.     
  134.     replaceText $pasteStart $pasteFinish $copyring($ringOut)
  135.     set pasteFinish [expr $pasteStart + [string length $copyring($ringOut)]]
  136. }
  137.